home *** CD-ROM | disk | FTP | other *** search
/ Tux Racer / Tux Racer.iso / program files / Sunspire Studios / Tux Racer / tcllib / quadtree.tcl next >
Encoding:
Text File  |  2001-11-26  |  3.9 KB  |  173 lines
  1.  
  2. namespace eval TRQuadTree {
  3.  
  4.     proc Rearrange { node levels } {
  5.     
  6.     set min_x  999999
  7.     set max_x -999999
  8.     set min_z  999999
  9.     set max_z -999999
  10.  
  11.     
  12.     # Traverse tree rooted at node, and create a list of all sgnodes that 
  13.     # we're going to move
  14.     set nodelist [TraverseNodes $node]
  15.  
  16.     # Find min and max coords
  17.     foreach n $nodelist {
  18.         if [objget $n drawable_bv_is_defined] {
  19.         set pos [objget $n drawable_bv_center]
  20.         } else {
  21.         set pos [objget $n position]
  22.         }
  23.  
  24.         set xpos [lindex $pos 0]
  25.         set zpos [lindex $pos 2]
  26.         if { $xpos < $min_x } { set min_x $xpos }
  27.         if { $xpos > $max_x } { set max_x $xpos }
  28.         if { $zpos < $min_z } { set min_z $zpos }
  29.         if { $zpos > $max_z } { set max_z $zpos }
  30.     }
  31.  
  32.     if { $min_x > $max_x || $min_z > $max_z } {
  33.         return;
  34.     }
  35.  
  36.     # Create root node of quadtree
  37.     set quadroot(x_orig) $min_x
  38.     set quadroot(z_orig) $min_z
  39.     set quadroot(size) [max [expr $max_x - $min_x] [expr $max_z - $min_z]]
  40.     set quadroot(level) [expr $levels-1]
  41.     set quadroot(node) $node
  42.     set quadroot(child,0) {}
  43.     set quadroot(child,1) {}
  44.     set quadroot(child,2) {}
  45.     set quadroot(child,3) {}
  46.  
  47.     foreach n $nodelist {
  48.         InsertInQuadTree $n quadroot
  49.     }
  50.  
  51.     # Remove any sgnodes without non-sgnode children
  52.     CleanUpSceneGraph $node
  53.     }
  54.  
  55.     proc InsertInQuadTree { node quadarray } {
  56.     upvar 1 $quadarray quad
  57.  
  58.     if [objget $node drawable_bv_is_defined] {
  59.         set pos [objget $node drawable_bv_center]
  60.     } else {
  61.         set pos [objget $node position]
  62.     }
  63.     set xpos [lindex $pos 0]
  64.     set zpos [lindex $pos 2]
  65.  
  66.     if { $quad(level) == 0 } {
  67.         set suffix ""
  68.         set i 0
  69.         while {1} {
  70.         if [objexists "$quad(node):[objget $node basename]$suffix"] {
  71.             incr i
  72.             set suffix "-$i"
  73.         } else {
  74.             break
  75.         }
  76.         }
  77.  
  78.         objmv $node $quad(node) "[objget $node basename]$suffix"
  79.  
  80.     } else {
  81.  
  82.         if { $xpos < $quad(x_orig) + $quad(size)/2.0 } {
  83.         if { $zpos < $quad(z_orig) + $quad(size)/2.0 } {
  84.             set index 0
  85.         } else {
  86.             set index 2
  87.         }
  88.         } else {
  89.         if { $zpos < $quad(z_orig) + $quad(size)/2.0 } {
  90.             set index 1
  91.         } else {
  92.             set index 3
  93.         }
  94.         }
  95.  
  96.         if { $quad(child,$index) == "" } {
  97.         CreateChild quad $index
  98.         }
  99.         array set childquad $quad(child,$index)
  100.         InsertInQuadTree $node childquad
  101.         set quad(child,$index) [array get childquad]
  102.         unset childquad
  103.     }
  104.     }
  105.  
  106.     proc CreateChild { quadarray index } {
  107.     upvar 1 $quadarray quad
  108.  
  109.     # Create root node of quadtree
  110.     set child(size) [expr $quad(size) / 2.0 ]
  111.  
  112.     set child(x_orig) [expr $quad(x_orig)]
  113.     if { $index % 2 == 1 } {
  114.         set child(x_orig) [expr $child(x_orig) + $child(size)]
  115.     }
  116.  
  117.     set child(z_orig) [expr $quad(z_orig)]
  118.     if { $index >= 2 } {
  119.         set child(z_orig) [expr $child(z_orig) + $child(size)]
  120.     }
  121.  
  122.     set child(level) [expr $quad(level)-1]
  123.  
  124.     set suffix ""
  125.     set i 0
  126.     while {1} {
  127.         if [catch {objnew s_sgnode $quad(node) node$index$suffix} newobj] {
  128.         incr i
  129.         set suffix "-$i"
  130.         } else {
  131.         break
  132.         }
  133.     }
  134.     set child(node) $newobj
  135.  
  136.     set child(child,0) {}
  137.     set child(child,1) {}
  138.     set child(child,2) {}
  139.     set child(child,3) {}
  140.  
  141.     set quad(child,$index) [array get child]
  142.     }
  143.  
  144.     proc TraverseNodes { node } {
  145.     set nodelist [list]
  146.     foreach child [objget $node children] {
  147.         if { [objcall $child is_a s_sgnode] && \
  148.             [objget $child allow_quadtreeify] } {
  149.  
  150.         if { ![objget $child world_matrix_is_identity] || \
  151.               [objget $child class] != ":classes:s_sgnode" } {
  152.             lappend nodelist $child
  153.         } else {
  154.             set nodelist [concat $nodelist [TraverseNodes $child]]
  155.         }
  156.         }
  157.     }
  158.     return $nodelist
  159.     }
  160.  
  161.     proc CleanUpSceneGraph { node } {
  162.     foreach child [objget $node children] {
  163.         CleanUpSceneGraph $child
  164.     }
  165.  
  166.     if { [objget $node class] == ":classes:s_sgnode" && \
  167.              [objget $node num_children] == 0 && \
  168.          [objcall $node can_delete] } {
  169.         objdel $node
  170.     }
  171.     }
  172. }
  173.